Attribute VB_Description = "vbaccelerator Owner Draw Combo and List box control."
Option Explicit
' Styles (simple combo is not provided by this control)
Public Enum EODCLStyle
' -- Combo box styles - bit 4 not set --
ecsDropDownCombo = 0
ecsDropDownList = 2
' -- List box styles have bit 4 set --
ecsListBox = 4
ecsListBoxMultiSelectSimple = 5
ecsListBoxMultiSelectExtended = 6
ecsListBoxChecked = 7
End Enum
' Draw modes for combo
Public Enum EODCLDrawMode
' -- Owner draw styles --
ecdNoClientDraw = 0 ' Only use default draw method
ecdDefaultDrawThenClient = 1 ' Perform default draw, but then raise client draw event
ecdClientDrawOnly = 2 ' Client does all drawing
' -- Special styles --
ecdColourPickerWithNames = 3
ecdColourPickerNoNames = 4
ecdSysColourPicker = 5
ecdParagraphStyles = 6
ecdFontPicker = 7
End Enum
' Alignment enums
Public Enum EODCLItemXAlign
eixLeft = DT_LEFT
eixCentre = DT_CENTER
eixRight = DT_RIGHT
End Enum
Private Const eixDT_VCENTRE = (DT_SINGLELINE Or DT_VCENTER)
Private Const eixDT_BOTTOM = (DT_SINGLELINE Or DT_BOTTOM)
Public Enum EODCLItemYAlign
eixTop = DT_TOP
eixVCentre = eixDT_VCENTRE
eixBottom = eixDT_BOTTOM
End Enum
' Column type enums
Public Enum EODCLColType
ectTextString = 0 ' The default - draw as text, sort as text
ectTextNumber = 1 ' Convert to number during sort
ectTextDateTime = 2 ' Convert to date for sort
ectImageListIcon = 4 ' Convert to icon index in image list & assume numeric during sort
End Enum
' Whether to drop down on return or not:
Private m_bExtendedUI As Boolean
' Whether sorted or not:
Private m_bSorted As Boolean
' Border style (doesn't seem to be changable without heavy hacking):
'Private m_eBorderStyle As EODCLBorderStyle
' Style
Private m_eStyle As EODCLStyle
' Auto complete mode for drop-down combo boxes:
Private m_bDoAutoComplete As Boolean
Private m_bOnlyAutoCompleteItems As Boolean
Private m_bDataIsSorted As Boolean
' Drop down width
Private m_lWidth As Long
Private m_hWndDropDown As Long
' Positioning drop down:
Private m_bPositionDropDown As Boolean
Private m_lPX As Long, m_lPY As Long
Private m_lPW As Long, m_lPH As Long
' Subclassing support:
Implements ISubclass
Private m_emr As EMsgResponse
Private m_bSubClass As Boolean
' Whether the user is going to draw the control, or if the default
' drawing mechanism should be used:
Private m_eClientDraw As EODCLDrawMode
Private m_lBorderLeft As Long
Private m_lBorderRight As Long
' Handle of combo box:
Private m_hWnd As Long
' Handle of edit portion if type=DropDownCombo
Private m_hWndEdit As Long
' Parent of combo box:
Private m_hWndparent As Long
' BackColour brush
Private m_hBackBrush As Long
' Max length of chars in edit box of DropDownCombo
Private m_lMaxLength As Long
' Whether we have created the font for an item:
Private m_bFontNotCreated As Boolean
' Last return code
Private m_lR As Long
' Last item added to combo box:
Private m_lNewItem As Long
' Fonts:
Private m_hFnt As Long
Private m_hFntOld As Long
Private m_tlF As LOGFONT
Private m_hUFnt As Long
Private m_tULF As LOGFONT
' ImageList:
Private m_hIml As Long
Private m_lIconWidth As Long
Private m_lIconHeight As Long
Private m_cIL As CImageList
Private m_hImlCache As Long
' Multiple column rendering:
Private m_iColCount As Integer
Private m_lColWidth() As Long
Private m_eCoLType() As EODCLColType
' Other appearance:
Private m_bFullRowSelect As Boolean
' Events for this control:
Public Event Click()
Attribute Click.VB_Description = "Raised when the ListIndex of the combo box or list box changes."
Public Event Change()
Attribute Change.VB_Description = "Raised when the contents of the combo box or list box are changed."
Public Event DblClick()
Attribute DblClick.VB_Description = "Raised when the list box or combo box is double clicked."
Public Event CloseUp()
Attribute CloseUp.VB_Description = "Raised when a combo box which was dropped down is closed up. See also the DropDown event."
Public Event DropDown()
Attribute DropDown.VB_Description = "Raised when the list box portion of a combo box is about to be shown."
Public Event SelCancel()
Attribute SelCancel.VB_Description = "Raised when the user cancels making a selection from the drop-down portion of a combo box by, for example, clicking another control."
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_Description = "Raised when a Key is first pressed down for an item in the control."
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_Description = "Raised when a key is released in the control."
Public Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_Description = "Raised when a Key is Pressed in the control."
Public Event MeasureItem(Index As Long, WidthPixels As Long, HeightPixels As Long)
Attribute MeasureItem.VB_Description = "Raised when the sizeof an item needs to be determined in a list or combo box with the ecdDefaultDrawThenClient or ecdClientOnly ClientDraw styles set."
Public Event DrawItem(Index As Long, hdc As Long, bSelected As Boolean, bEnabled As Boolean, LeftPixels As Long, TopPixels As Long, RightPixels As Long, BottomPixels As Long, hFntOld As Long)
Attribute DrawItem.VB_Description = "Raised when an item needs to be drawn in a list or combo box with the ecdDefaultDrawThenClient or ecdClientOnly ClientDraw styles set."
Public Event AutoCompleteSelection(ByVal sItem As String, ByVal lIndex As Long)
Attribute AutoCompleteSelection.VB_Description = "Raised when the user clicks enter in a drop-down combo box with Auto Complete mode set."
Property Get DoAutoComplete() As Boolean
Attribute DoAutoComplete.VB_Description = "Gets/sets whether a drop-down combo will attempt to automatically complete the user's typing based on the contents of the list."
If (m_eStyle = ecsDropDownCombo) Then
DoAutoComplete = m_bDoAutoComplete
Else
DoAutoComplete = False
End If
End Property
Property Let DoAutoComplete(ByVal bState As Boolean)
m_bDoAutoComplete = bState
End Property
Public Property Get AutoCompleteListItemsOnly() As Boolean
Attribute AutoCompleteListItemsOnly.VB_Description = "Gets/sets whethera drop-down combo with Auto Complete mode on should only allow selections of items in the list, or should allow any text to be entered."
Public Property Let AutoCompleteListItemsOnly(ByVal bState As Boolean)
m_bOnlyAutoCompleteItems = bState
End Property
Public Property Get AutoCompleteItemsAreSorted() As Boolean
Attribute AutoCompleteItemsAreSorted.VB_Description = "Gets/sets whether the items in a drop-down combo with Auto Complete mode on should be regarded as sorted."
If StrComp(LCase$(left$(List(i), lLen)), sLTotal) = 0 Then
iFound = i
Exit For
End If
Next i
If (iFound > -1) Then
ListIndex = iFound
'Text = List(iFound)
SelStart = Len(sTotal)
SelLength = Len(List(iFound)) - SelStart + 1
iKeyAscii = 0
Else
If (m_bOnlyAutoCompleteItems) Then
' is there anything we can choose which has the same unmatched letters?
iStart = ListIndex
sLUnSel = LCase$(sUnSel)
lLen = Len(sLUnSel)
If (lLen > 0) Then
If (m_bDataIsSorted) Then
' Its either the next one down or the first in the list:
i = iStart + 1
If StrComp(LCase$(left$(List(i), lLen)), sLUnSel) = 0 Then
iFound = i
Else
For i = 0 To iStart - 1
If StrComp(LCase$(left$(List(i), lLen)), sLUnSel) = 0 Then
iFound = i
Exit For
End If
Next i
End If
Else
' it could be anything following list index, or anything preceeding it:
For i = iStart + 1 To ListCount - 1
If StrComp(LCase$(left$(List(i), lLen)), sLUnSel) = 0 Then
iFound = i
Exit For
End If
Next i
If (iFound < 0) Then
For i = 0 To iStart - 1
If StrComp(LCase$(left$(List(i), lLen)), sLUnSel) = 0 Then
iFound = i
Exit For
End If
Next i
End If
End If
If (iFound > -1) Then
ListIndex = iFound
SelStart = lLen
SelLength = Len(List(iFound)) - SelStart + 1
End If
Else
Beep
End If
iKeyAscii = 0
End If
End If
End Sub
Property Get FullRowSelect() As Boolean
Attribute FullRowSelect.VB_Description = "Gets/sets whether a selection in a list will cover the entire row or just highlight the selected item's text."
FullRowSelect = m_bFullRowSelect
End Property
Property Let FullRowSelect(ByVal bState As Boolean)
m_bFullRowSelect = bState
End Property
Property Get Columns() As Integer
Attribute Columns.VB_Description = "Gets/sets the number of columns shown in a list box or combo box."
If (m_iColCount < 1) Then
Columns = 1
Else
Columns = m_iColCount
End If
End Property
Property Let Columns(ByVal iColCount As Integer)
If (iColCount <> m_iColCount) Then
If (iColCount < 1) Then
Erase m_lColWidth
Erase m_eCoLType
m_iColCount = 1
Else
m_iColCount = iColCount
ReDim Preserve m_lColWidth(1 To m_iColCount) As Long
ReDim Preserve m_eCoLType(1 To m_iColCount) As EODCLColType
End If
pRefreshControl
End If
End Property
Property Get ColWidth(ByVal iCol As Integer) As Long
Attribute ColWidth.VB_Description = "Gets/sets the width of column in a list box or combo box with more than one column."
ColWidth = m_lColWidth(iCol)
End Property
Property Let ColWidth(ByVal iCol As Integer, ByVal lWidthPixels As Long)
Dim tR As RECT
If (lWidthPixels <> m_lColWidth(iCol)) Then
m_lColWidth(iCol) = lWidthPixels
pRefreshControl
End If
End Property
Property Get ColType(ByVal iCol As Integer) As EODCLColType
Attribute ColType.VB_Description = "Gets/sets the type of item to be displayed in a column of a combo or list box with more than one column."
ColType = m_eCoLType(iCol)
End Property
Property Let ColType(ByVal iCol As Integer, ByVal eColType As EODCLColType)
If (m_eCoLType(iCol) <> eColType) Then
m_eCoLType(iCol) = eColType
pRefreshControl
End If
End Property
Property Get InternalImageList() As CImageList
Attribute InternalImageList.VB_Description = "Returns a cImageList object which used by the control to draw icons. You can use this rather than an external image list if you wish."
' If we haven't got an internal image list:
If m_cIL Is Nothing Then
' Create one:
pCreateImageList
End If
' Return the image list object
Set InternalImageList = m_cIL
End Property
Property Get Selected(ByVal Index As Long) As Boolean
Attribute Selected.VB_Description = "Gets/sets whether an item is selected in a multi select list box."
Dim lR As Long
' Selected property is only valid for multi select
' list boxes (always returns false otherwise):
If (m_eStyle > ecsListBox) Then
If (m_hWnd <> 0) Then
lR = SendMessageByLong(m_hWnd, LB_GETSEL, Index, 0)
Selected = (lR > 0)
End If
End If
End Property
Property Let Selected(ByVal Index As Long, ByVal bSelected As Boolean)
Dim lS As Long
' Selected property is only valid for multi select
Public Sub SetDefaultDrawBorder(ByVal LeftPixels As Long, ByVal RightPixels As Long)
Attribute SetDefaultDrawBorder.VB_Description = "Sets the offset position for any drawing in the list box portion of the control from the borders when in default draw mode."
' When in default draw mode, any drawing in the
' list box portion of the control will be
' offset from the borders by these amounts:
m_lBorderLeft = LeftPixels
m_lBorderRight = RightPixels
End Sub
Property Get Text() As String
Attribute Text.VB_Description = "Gets/sets the text in the edit portion of a drop-down combo box, or returns the text of the first selected item in other types."
Dim lR As Long
Dim sText As String
' Returns either the text in the EditBox portion of a
' drop down combo or the text of the (first) selected
' list item:
If (m_hWnd <> 0) Then
If (m_eStyle = ecsDropDownCombo) Then
lR = SendMessageByLong(m_hWnd, WM_GETTEXTLENGTH, 0, 0)
If (lR > 0) Then
sText = String$(lR + 1, Chr$(0))
lR = SendMessageByString(m_hWnd, WM_GETTEXT, (lR + 1), sText)
Attribute SelStart.VB_Description = "Gets the start of the selection in the edit portion of a drop down combo box."
Attribute SelStart.VB_MemberFlags = "400"
Dim lStart As Long, lENd As Long
' Return the start of the selected text in the edit
' box portion of a dropdown combo:
If (m_eStyle = ecsDropDownCombo) Then
pGetSelStartEnd lStart, lENd
SelStart = lStart
Else
Err.Raise 383, "OwnerDrawCombo." & App.EXEName
End If
End Property
Property Let SelStart(ByVal lStart As Long)
Dim lOStart As Long, lENd As Long
' Set the start of the selected text in the edit
' box portion of a dropdown combo:
If (m_eStyle = ecsDropDownCombo) Then
pGetSelStartEnd lOStart, lENd
If (lStart <> lOStart) Then
pSetSelStartEnd lStart, lENd
End If
Else
Err.Raise 383, "OwnerDrawCombo." & App.EXEName
End If
End Property
Property Get SelLength() As Long
Attribute SelLength.VB_Description = "Gets the length of the selection in the edit portion of a drop down combo box."
Attribute SelLength.VB_MemberFlags = "400"
Dim lStart As Long, lENd As Long
' Return the length of the selected text in the edit
' box portion of a dropdown combo:
If (m_eStyle = ecsDropDownCombo) Then
pGetSelStartEnd lStart, lENd
SelLength = lENd - lStart
Else
Err.Raise 383, "OwnerDrawCombo." & App.EXEName
End If
End Property
Property Let SelLength(ByVal lLength As Long)
Dim lStart As Long, lENd As Long
' Set the length of the selected text in the edit
' box portion of a dropdown combo:
If (m_eStyle = ecsDropDownCombo) Then
pGetSelStartEnd lStart, lENd
If (lENd - lStart <> lLength) Then
pSetSelStartEnd lStart, lStart + lLength
End If
Else
Err.Raise 383, "OwnerDrawCombo." & App.EXEName
End If
End Property
Property Get SelText() As String
Attribute SelText.VB_Description = "Gets the selected text from the edit portion of a drop down combo box."
' Return the selected text from the edit
' box portion of a dropdown combo:
If (m_eStyle = ecsDropDownCombo) Then
Dim sText As String
Dim lStart As Long, lENd As Long
pGetSelStartEnd lStart, lENd
sText = Text
If (lENd > 0) And Len(sText) > 0 Then
If (lStart <= 0) Then
lStart = 1
End If
lENd = lENd + 1
If (lENd > Len(sText)) Then lENd = Len(sText)
SelText = Mid$(sText, lStart, (lENd - lStart))
End If
Else
SelText = Text
End If
End Property
Property Get hwnd() As Long
Attribute hwnd.VB_Description = "Gets the hWnd of the combo box or list box control. If you want the hWnd of the control itself, find the parent of this handle."
' Return the hWnd of the Combo or List.
hwnd = m_hWnd
End Property
Property Get hWndEdit() As Long
Attribute hWndEdit.VB_Description = "Gets the hWnd of the edit box in a drop-down combo control."
hWndEdit = m_hWndEdit
End Property
Property Let ImageList(ByRef vThis As Variant)
Attribute ImageList.VB_Description = "Sets the image list to be used to draw icons in the control. Can either be set to a Visual Basic Image List control or a hImageList handle to an API image list."
Dim tR As RECT
' Set the ImageList handle property either from a VB
' image list or directly:
m_hIml = 0
If VarType(vThis) = vbObject Then
' Assume VB ImageList control. Note that unless
' some call has been made to an object within a
' VB ImageList the image list itself is not
' created. Therefore hImageList returns error. So
' ensure that the ImageList has been initialised by
' drawing into nowhere:
On Error Resume Next
' Get the image list initialised..
vThis.ListImages(1).Draw 0, 0, 0, 1
m_hImlCache = vThis.hImageList
If (Err.Number <> 0) Then
m_hImlCache = 0
End If
On Error GoTo 0
ElseIf VarType(vThis) = vbLong Then
' Assume ImageList handle:
m_hImlCache = vThis
Else
Err.Raise vbObjectError + 1049, "OwnerDrawCombo." & App.EXEName, "ImageList property expects ImageList object or long hImageList handle."
End If
If (m_eClientDraw = ecdParagraphStyles) Or (m_eClientDraw = ecdFontPicker) Then
' Do not change m_hIml yet, wait until style changes away from
' these styles.
Else
m_hIml = m_hImlCache
End If
If (m_hImlCache <> 0) Then
ImageList_GetImageRect m_hImlCache, 0, tR
m_lIconWidth = tR.Right - tR.left
m_lIconHeight = tR.Bottom - tR.tOp
End If
End Property
Property Get ItemIcon( _
ByVal lListIndex As Long _
) As Long
Attribute ItemIcon.VB_Description = "Gets/sets the icon to draw next to an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Returns the icon for a list item:
hMem = plGetItemData(lListIndex)
pGetItemInfo hMem, tLI
ItemIcon = tLI.lIconIndex
End Property
Property Let ItemIcon( _
ByVal lListIndex As Long, _
ByVal lIconIndex As Long _
)
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Sets the icon for a list item:
hMem = plGetItemData(lListIndex)
pGetItemInfo hMem, tLI
tLI.lIconIndex = lIconIndex
pWriteItemInfo hMem, tLI
pRedrawItem lListIndex
End Property
Property Get ItemIndent( _
ByVal lIndex As Long _
) As Long
Attribute ItemIndent.VB_Description = "Gets/sets the number of pixels to an indent an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Returns the indent for a list item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
ItemIndent = tLI.lIndentSize
End Property
Property Let ItemIndent( _
ByVal lIndex As Long, _
ByVal lIndentSize As Long _
)
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Sets the indent for a list item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
tLI.lIndentSize = lIndentSize
pWriteItemInfo hMem, tLI
pRedrawItem lIndex
End Property
Property Get ItemBackColor( _
ByVal lIndex As Long _
) As OLE_COLOR
Attribute ItemBackColor.VB_Description = "Gets/sets the back color of an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Returns the back colour for an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
If (tLI.lBackColour = -1) Then
ItemBackColor = UserControl.BackColor
Else
ItemBackColor = tLI.lBackColour
End If
End Property
Property Let ItemBackColor( _
ByVal lIndex As Long, _
ByVal lBackColour As OLE_COLOR _
)
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Sets the back colour for an item. Set to -1 for default:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
tLI.lBackColour = lBackColour
pWriteItemInfo hMem, tLI
pRedrawItem lIndex
End Property
Property Get ItemXAlign( _
ByVal lIndex As Long _
) As EODCLItemXAlign
Attribute ItemXAlign.VB_Description = "Gets/sets the X Alignment of text drawn for an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Returns the horizontal text alignment for an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
ItemXAlign = tLI.lTextAlignX
End Property
Property Let ItemXAlign( _
ByVal lIndex As Long, _
ByVal eXAlign As EODCLItemXAlign _
)
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Sets the horizontal text alignment for an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
tLI.lTextAlignX = eXAlign
pWriteItemInfo hMem, tLI
pRedrawItem lIndex
End Property
Property Get ItemYAlign( _
ByVal lIndex As Long _
) As EODCLItemYAlign
Attribute ItemYAlign.VB_Description = "Gets/sets the Y Alignment of text drawn for an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Returns the vertical text alignment for an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
ItemYAlign = tLI.lTextAlignY
End Property
Property Let ItemYAlign( _
ByVal lIndex As Long, _
ByVal eYAlign As EODCLItemYAlign _
)
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Sets the vertical text alignment for an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
tLI.lTextAlignY = eYAlign
pWriteItemInfo hMem, tLI
pRedrawItem lIndex
End Property
Property Get ItemExtraData( _
ByVal lIndex As Long _
) As Long
Attribute ItemExtraData.VB_Description = "Gets/sets an additional long value associated withf an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Returns an extra long stored with an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
ItemExtraData = tLI.lExtraData
End Property
Property Let ItemExtraData( _
ByVal lIndex As Long, _
ByVal lExtraData As Long _
)
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Sets an extra long stored with an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
tLI.lExtraData = lExtraData
pWriteItemInfo hMem, tLI
End Property
Property Get ItemForeColor( _
ByVal lIndex As Long _
) As OLE_COLOR
Attribute ItemForeColor.VB_Description = "Gets/sets the fore color of an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Returns the fore colour for an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
If (tLI.lForeColour = -1) Then
ItemForeColor = UserControl.ForeColor
Else
ItemForeColor = tLI.lForeColour
End If
End Property
Property Let ItemForeColor( _
ByVal lIndex As Long, _
ByVal lForeColour As OLE_COLOR _
)
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Sets the fore colour for an item:
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
tLI.lForeColour = lForeColour
pWriteItemInfo hMem, tLI
pRedrawItem lIndex
End Property
Public Sub AddItemAndData( _
ByVal sItem As String, _
Optional ByVal lIconIndex As Long = -1, _
Optional ByVal lIndent As Long = 0, _
Optional ByVal lForeColour As OLE_COLOR = -1, _
Optional ByVal lBackColour As OLE_COLOR = -1, _
Optional ByVal lItemData As Long = 0, _
Optional ByVal lExtraData As Long = 0, _
Optional ByVal lHeight As Long = -1, _
Optional ByVal eTextXAlign As EODCLItemXAlign = eixLeft, _
Optional ByVal eTextYAlign As EODCLItemYAlign = eixTop, _
Optional ByRef fntThis As StdFont = Nothing _
)
Attribute AddItemAndData.VB_Description = "Adds an item to the combo or list box and also allows font, colours, formatting or icons to be set at the same time."
Dim wMsg As Long
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
' Same as AddItem, but the extended properties can be
Attribute AddItem.VB_Description = "Adds an item to the combo or list box (same as VB List box AddItem method). Use AddItemWithData for a quicker method if you also want to set icons, formatting, colours etc for the item."
' AddItem method same as VB AddItem for a ListBox
' or ComboBox.
' Just call AddItemWithData with all the defaults set:
AddItemAndData sItem
End Sub
Property Get NewIndex() As Long
Attribute NewIndex.VB_Description = "Gets the index of the latest item to be added to the control."
' Returns the last index added to the control:
NewIndex = m_lNewItem
End Property
Property Let ItemUnderLine( _
ByVal lIndex As Long, _
ByVal bUnderLineItem As Boolean _
)
Attribute ItemUnderLine.VB_Description = "Gets/sets whether a separator line should be drawn below an item in the control."
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
tLI.bUnderLineItem = bUnderLineItem
pWriteItemInfo hMem, tLI
End Property
Property Get ItemUnderLine( _
ByVal lIndex As Long _
) As Boolean
Dim tLI As ICONLISTBOXITEMINFO
Dim hMem As Long
hMem = plGetItemData(lIndex)
pGetItemInfo hMem, tLI
ItemUnderLine = tLI.bUnderLineItem
End Property
Property Let ItemFont( _
ByVal lIndex As Long, _
fntThis As StdFont _
)
Attribute ItemFont.VB_Description = "Gets/sets the font with which to draw an item in the control."
Optional ByVal eTextXAlign As EODCLItemXAlign = eixLeft, _
Optional ByVal eTextYAlign As EODCLItemYAlign = eixTop, _
Optional ByRef fntThis As StdFont = Nothing _
)
Attribute InsertItemAndData.VB_Description = "Inserts an item to the combo or list box and also allows font, colours, formatting or icons to be set at the same time."
Attribute InsertItem.VB_Description = "Inserts an item in the list items of a combo or list box. Use InsertItemWithData for a quicker method if you also want to set icons, formatting, colours etc for the item."
Attribute RemoveItem.VB_Description = "Removes an item from the control's list."
Dim wMsg As Long
Dim hMem As Long
If lIndex < ListCount And lIndex > -1 Then
' Firstly remove the memory associated with this index:
hMem = plGetItemData(lIndex)
GlobalFree hMem
' Now remove the string:
If (m_eStyle And ecsListBox) = ecsListBox Then
wMsg = LB_DELETESTRING
Else
wMsg = CB_DELETESTRING
End If
m_lR = SendMessageByLong(m_hWnd, wMsg, lIndex, 0)
If (m_lR = CB_ERR) Then
' Raise error
Debug.Print "RemoveItem: Error!"
End If
Else
' Raise error...
Debug.Print "RemoveItem: Error!"
End If
End Sub
Property Get ListIndex() As Long
Attribute ListIndex.VB_Description = "Gets/sets the currently selected item in the list. In multi-select list boxes, this returns the first selected item. Use the Selected property instead."
Attribute ListIndex.VB_MemberFlags = "400"
Dim wMsg As Long
If (m_eStyle And ecsListBox) = ecsListBox Then
wMsg = LB_GETCURSEL
Else
wMsg = CB_GETCURSEL
End If
m_lR = SendMessageByLong(m_hWnd, wMsg, 0, 0)
ListIndex = m_lR
End Property
Property Let ListIndex( _
ByVal lIndex As Long _
)
Dim wMsg As Long
If (m_eStyle And ecsListBox) = ecsListBox Then
wMsg = LB_SETCURSEL
Else
wMsg = CB_SETCURSEL
End If
m_lR = SendMessageByLong(m_hWnd, wMsg, lIndex, 0)
If (m_lR = CB_ERR) And (lIndex <> -1) Then
Err.Raise 381, App.EXEName & ".ODCboLst"
Else
RaiseEvent Click
End If
If (m_eClientDraw = ecdFontPicker) Then
' Here we cache the fonts
End If
End Property
Private Sub pGetItemInfo( _
ByVal hMem As Long, _
ByRef tLI As ICONLISTBOXITEMINFO _
)
Dim lPtr As Long
If (hMem <> 0) And (hMem <> CB_ERR) Then
' Get a pointer to the memory block
' pointed to by hMem:
lPtr = GlobalLock(hMem)
' Copy the memory into tLI
CopyMemory tLI, ByVal lPtr, Len(tLI)
' Lock the memory again:
GlobalUnlock hMem
End If
End Sub
Private Sub pWriteItemInfo( _
ByVal hMem As Long, _
ByRef tLI As ICONLISTBOXITEMINFO _
)
Dim lPtr As Long
' Get a pointer to the memory block
' pointed to by hMem:
lPtr = GlobalLock(hMem)
' Copy the memory into tLI
CopyMemory ByVal lPtr, tLI, Len(tLI)
' Lock the memory again:
GlobalUnlock hMem
End Sub
Property Get ListCount() As Long
Attribute ListCount.VB_Description = "Gets the number of items in the control's list."
Dim wMsg As Long
If (m_eStyle And ecsListBox) = ecsListBox Then
wMsg = LB_GETCOUNT
Else
wMsg = CB_GETCOUNT
End If
ListCount = SendMessageByLong(m_hWnd, wMsg, 0, 0)
End Property
Property Let itemHeight( _
ByVal lIndex As Long, _
ByVal lItemHeight As Long _
)
Attribute itemHeight.VB_Description = "Gets/sets the height of an item in the control."
Attribute ExtendedUI.VB_Description = "Gets/sets whether the list box portion of a combo box will drop down in response to the down key rather than the F4 key."
' Whether a dropdownlist combo box drops down in
' response to the down arrow as well as F4
ExtendedUI = m_bExtendedUI
End Property
Property Let ExtendedUI(ByVal bExtendedUI As Boolean)
Dim lS As Long
Dim lR As Long
' Whether a dropdownlist combo box drops down in
' response to the down arrow as well as F4
If m_bExtendedUI <> bExtendedUI Then
m_bExtendedUI = bExtendedUI
If (m_eStyle <> ecsListBox) Then
If (m_hWnd <> 0) Then
lS = -1 * (bExtendedUI = True)
lR = SendMessageByLong(m_hWnd, CB_SETEXTENDEDUI, lS, 0)
End If
End If
PropertyChanged "ExtendedUI"
End If
End Property
Property Get Style() As EODCLStyle
Attribute Style.VB_Description = "Gets/sets the type of list box or combo box the control will be."
' Get the Style
Style = m_eStyle
End Property
Property Let Style(ByVal eStyle As EODCLStyle)
' Set the Style. Note changing this property during
' run mode will have no effect... Should raise an
' error, really. Alternatively this could actually
' change the style of the box. Since to get a new
' style the original window has to be destroyed, you
' would have to store all the items and their associated
' extended properties, remove the subclass, call pInitialise
' for the new style, make a new subclass and then add the
' items again.
If (m_eStyle <> eStyle) Then
m_eStyle = eStyle
' If in design mode (no items in the box) then
' change
If Not (UserControl.Ambient.UserMode) Then
pInitialise
End If
UserControl.BorderStyle = ((m_eStyle And ecsListBox) = ecsListBox) * -1
PropertyChanged "Style"
End If
End Property
Property Get Sorted() As Boolean
Attribute Sorted.VB_Description = "Gets/sets whether the list items in the control will be sorted."
' Whether the control is sorted or not:
Sorted = m_bSorted
End Property
Property Let Sorted(ByVal bSorted As Boolean)
' THis will have no effect at runtime:
If (bSorted <> m_bSorted) Then
m_bSorted = bSorted
PropertyChanged "Sorted"
End If
End Property
Property Get DropDownWidth() As Long
Attribute DropDownWidth.VB_Description = "Gets/sets the width to show the drop down portion of a combo box."
' Get the width of the drop down portion of a combo box
' in pixels:
DropDownWidth = m_lWidth
End Property
Property Let DropDownWidth(lWidth As Long)
Dim lAWidth As Long
' Set the width of the drop down portion of a combo box
